home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual Foxpro 6.0 (Ent. Edition) / Vf6ent Extractor.EXE / TOOLS / XSOURCE / XSOURCE.ZIP / vfpsource / wizards / Wzpivot / xtabwiz.prg < prev   
Encoding:
Text File  |  1998-05-01  |  7.3 KB  |  259 lines
  1. #DEFINE     C_SAVEPROMPT_LOC    "Save query as:"
  2. #DEFINE        NOGENXTAB_LOC        "Could not locate GENXTAB.PRG file. Make sure you have it properly installed."
  3. #DEFINE        GENXTAB_FILE        "VFPXTAB.PRG"
  4. #DEFINE        FIELDERR_LOC        "Could not create crosstab from table selected."
  5. #DEFINE        RUNQUERY_LOC        "Running query..."
  6. #DEFINE        C_NOVIEWS_LOC        "Views are not supported in QPR files."
  7. #DEFINE        C_CRLF                 CHR(13)+CHR(10)
  8. #DEFINE     OS_W32S                1
  9.  
  10. DEFINE CLASS XtabEngine AS WizEngineAll
  11.  
  12.     cWizClass = "misc"            &&wizard class    (e.g., report)
  13.     cWizName  = "xtabwizard"    &&wizard name or class (e.g., Group/Total report)
  14.     iHelpContextID = 1895825410    &&help id
  15.  
  16.     cPivFldData = ""            &&Pivot data field
  17.     cPivFldPage = ""            &&Pivot page field
  18.     cPivFldRow = ""                &&Pivot row field
  19.     cPivFldCol = ""                &&Pivot column field
  20.  
  21.     lHasColumnTotals = .T.        &&Column totals
  22.     lHasRowTotals = .T.            &&Row totals
  23.     lIsNumeric = .F.            &&numeric data type
  24.     nTotalType = 0                &&total type (1-sum,2-count,3-% total)
  25.     nFldSumType = 1                &&field sum type (1-sum,2-count,3-average,4-max,5-min)
  26.     lDisplayNulls = .T.            &&display null values
  27.     
  28.     ordExpr = ""                &&order by, group by expression
  29.     fldExpr = ""                &&fields expression
  30.     cXtabAlias = ""                &&alias for query
  31.     cXtabSource = ""            &&data source for query
  32.     
  33.     PROCEDURE Init2
  34.         THIS.GetOS()
  35.     ENDPROC
  36.  
  37.     PROCEDURE GetSaveFile
  38.         PARAMETER cCurAlias
  39.         LOCAL getfname
  40.         IF THIS.nWizAction = 0
  41.             RETURN .T.
  42.         ENDIF
  43.         DO CASE
  44.         CASE THIS.nCurrentOS = OS_W32S AND ;
  45.           CURSORGETPROP("sourcetype",m.cCurAlias) = 3
  46.             * use short DOS name for Win32S
  47.             getfname = THIS.ForceExt(DBF(m.cCurAlias),"QPR")
  48.         CASE THIS.nCurrentOS = OS_W32S 
  49.             getfname = LEFT(m.cCurAlias,8) + ".QPR"
  50.         OTHERWISE
  51.             getfname = THIS.ForceExt(cursorgetprop("sourcename",m.cCurAlias),"QPR")
  52.         ENDCASE
  53.  
  54.         RETURN THIS.SaveOutFile(C_SAVEPROMPT_LOC,m.getfname,"QPR")  &&use canceled
  55.     ENDPROC
  56.  
  57.     PROCEDURE MakeOutput
  58.         LOCAL cQPRFile,cDataFld 
  59.         * Make sure we have _GENXTAB file
  60.         IF EMPTY(_GENXTAB)
  61.             IF FILE(HOME()+GENXTAB_FILE)
  62.                 _GENXTAB = HOME()+GENXTAB_FILE
  63.             ELSE
  64.                 THIS.ALERT(NOGENXTAB_LOC)
  65.                 RETURN    
  66.             ENDIF
  67.         ENDIF
  68.         
  69.         IF TYPE('THIS.nWizAction') # 'N'
  70.             THIS.nWizAction = 3
  71.         ENDIF
  72.         
  73.         * Check fields
  74.         IF EMPTY(THIS.cPivFldData)
  75.             THIS.cPivFldData= THIS.GetNewField(0)
  76.         ENDIF
  77.         IF EMPTY(THIS.cPivFldRow)
  78.             THIS.cPivFldRow = THIS.GetNewField()
  79.         ENDIF
  80.         IF EMPTY(THIS.cPivFldCol)
  81.             THIS.cPivFldCol= THIS.GetNewField()
  82.         ENDIF
  83.  
  84.         IF EMPTY(THIS.cPivFldRow) OR EMPTY(THIS.cPivFldCol) OR EMPTY(THIS.cPivFldData)
  85.             THIS.ALERT(FIELDERR_LOC)
  86.             RETURN
  87.         ENDIF
  88.         
  89.         IF !EMPTY(CURSORGETPROP("database"))            && DBC stuff
  90.             THIS.cXtabSource = PROPER(CURSORGETPROP("SourceName"))
  91.         ELSE                                            && free tables
  92.             THIS.cXtabSource = SYS(2014,DBF(),THIS.cOutFile)
  93.         ENDIF
  94.  
  95.         THIS.cXtabAlias = ALIAS()
  96.         
  97.         * Get SQL Select statement pieces
  98.         THIS.ordExpr = THIS.cXtabAlias +"."+THIS.cPivFldRow+", "+THIS.cXtabAlias+"."+THIS.cPivFldCol
  99.         
  100.         * Get field expression
  101.         m.cDataFld = THIS.cXtabAlias +"."+THIS.cPivFldData
  102.         
  103.         DO CASE
  104.         CASE INLIST(THIS.nFldSumType,1,3) AND ATC(TYPE(m.cDataFld),"NFIYB")=0 
  105.             * non-numeric data type
  106.             THIS.fldExpr = THIS.ordExpr+", "+m.cDataFld
  107.         CASE THIS.nFldSumType = 1    && sum
  108.             THIS.fldExpr = THIS.ordExpr+", SUM("+m.cDataFld+")"
  109.         CASE THIS.nFldSumType = 2    && count
  110.             THIS.fldExpr = THIS.ordExpr+", COUNT("+m.cDataFld+")"
  111.         CASE THIS.nFldSumType = 3    && average
  112.             THIS.fldExpr = THIS.ordExpr+", AVG("+m.cDataFld+")"
  113.         CASE THIS.nFldSumType = 4    && max
  114.             THIS.fldExpr = THIS.ordExpr+", MAX("+m.cDataFld+")"
  115.         CASE THIS.nFldSumType = 5    && min        
  116.             THIS.fldExpr = THIS.ordExpr+", MIN("+m.cDataFld+")"
  117.         ENDCASE
  118.         
  119.         * Check totaling
  120.         THIS.lHasRowTotals = (THIS.nTotalType#4)
  121.         
  122.         * Map total property to that of VFPXTAB 
  123.         THIS.nTotalType = THIS.nTotalType - 1
  124.         
  125.         * User hit Preview button
  126.         IF THIS.nWizAction = 0
  127.             THIS.RunXtab()
  128.             THIS.nTotalType = THIS.nTotalType + 1
  129.             RETURN
  130.         ENDIF
  131.         
  132.         m.cQPRFile = "'"+THIS.cOutFile+"'"
  133.         THIS.MakeQPR()
  134.  
  135.         * Handle View since we did a USE ... NODATA in Wizard
  136.         IF CURSORGETPROP("SourceType") # 3
  137.             IF THIS.nWizAction = 1
  138.                 USE
  139.             ELSE
  140.                 =REQUERY()
  141.                 GO TOP
  142.             ENDIF
  143.         ENDIF
  144.         
  145.         DO CASE
  146.         CASE THIS.nWizAction = 1    &&save cross tab query
  147.             * Nothing - just return
  148.         CASE THIS.nWizAction = 2    &&save and run cross tab query
  149.             _SHELL = [DO &cQPRFile]
  150.         CASE THIS.nWizAction = 3    &&save and modify cross tab query
  151.             _SHELL = [MODIFY QUERY &cQPRFile NOWAIT]
  152.         ENDCASE
  153.         
  154.     ENDPROC
  155.  
  156.     PROCEDURE RunXtab
  157.         * Preview here
  158.         LOCAL cAlias,cOrd,cFld,cTmpAlias
  159.         m.cAlias = THIS.cXtabAlias
  160.         m.cOrd = THIS.ordExpr
  161.         m.cFld = THIS.fldExpr
  162.  
  163.         SELECT &cFld ;
  164.             FROM &cAlias ; 
  165.             GROUP BY &cOrd ; 
  166.             ORDER BY &cOrd ;
  167.             INTO CURSOR SYS(2015)
  168.         m.cTmpAlias = ALIAS()
  169.         WAIT CLEAR
  170.         
  171.         IF !THIS.haderror
  172.             DO (_GENXTAB) WITH "wizquery",.t.,.t.,.t.,,,,THIS.lHasRowTotals,THIS.nTotalType,THIS.lDisplayNulls
  173.             IF UPPER(ALIAS())="WIZQUERY"
  174.                 BROWSE NOMODIFY NORMAL
  175.             ENDIF
  176.         ENDIF
  177.         
  178.         * Check to see if VFPXTAB failed
  179.         IF USED(m.cTmpAlias)
  180.             USE IN (m.cTmpAlias)
  181.         ENDIF
  182.     ENDPROC
  183.     
  184.     PROCEDURE MakeQPR
  185.         * Makes a temporary cursor with memo to create QPR files
  186.         LOCAL cTmpCursor,nWkArea,cFullTable,cDBCPath
  187.         m.nWkArea = SELECT()
  188.         m.cTmpCursor = SYS(2015)
  189.         m.cFullTable = THIS.cXtabSource
  190.  
  191.         IF !EMPTY(CURSORGETPROP('database'))  &&lets put the DBC alias before table
  192.             cDBCPath = THIS.JustStem(SYS(2014,CURSORGETPROP('database'),THIS.cOutFile))
  193.             cFullTable = m.cDBCPath + "!" + m.cFullTable
  194.         ENDIF
  195.         
  196.         cFullTable = "'"+m.cFullTable+"' "+THIS.cXtabAlias
  197.         
  198.         CREATE CURSOR (m.cTmpCursor) (sqlstring m)
  199.         APPEND BLANK
  200.         REPLACE sqlstring WITH ;
  201.             "SELECT "+THIS.fldExpr + ";" + C_CRLF +;
  202.             "    FROM " + m.cFullTable + ";" + C_CRLF +;
  203.             "    GROUP BY " + THIS.ordExpr + ";" + C_CRLF +;
  204.             "    ORDER BY " + THIS.ordExpr + ";" + C_CRLF +;
  205.             "    INTO CURSOR SYS(2015)" + C_CRLF +;            
  206.             "DO (_GENXTAB) WITH 'Query'"+;
  207.             IIF(THIS.lHasRowTotals,",.t.,.t.,.t.,,,,.t.,"+ALLTRIM(STR(THIS.nTotalType))+;
  208.             IIF(THIS.lDisplayNulls,',.t.',',.f.'),IIF(!THIS.lDisplayNulls,"",",,,,,,,,,.t.")) + C_CRLF +;
  209.             "BROWSE NOMODIFY" ADDITIVE
  210.  
  211.  
  212.         COPY MEMO sqlstring TO (THIS.cOutFile)
  213.         USE
  214.         SELECT (m.nWkArea)
  215.     ENDPROC
  216.     
  217.     PROCEDURE GetNewField
  218.         LPARAMETER p1
  219.         * This routine finds a field if one not selected.
  220.         LOCAL i,tmparr,lNumPref 
  221.         m.lNumPref = (PARAMETER()=1)
  222.         DIMENSION tmparr[1]
  223.         =AFIELDS(tmparr)
  224.         
  225.         IF m.lNumPref 
  226.             FOR i = 1 TO FCOUNT()
  227.                 * Check to make sure field is not being used or General/Memo field.
  228.                 IF !INLIST(FIELD(m.i),UPPER(THIS.cPivFldRow),;
  229.                     UPPER(THIS.cPivFldCol),UPPER(THIS.cPivFldData)) AND ;
  230.                     INLIST(tmparr[m.i,2],"N","F","Y","B")
  231.                     RETURN FIELD(m.i)
  232.                 ENDIF
  233.             ENDFOR
  234.         ENDIF
  235.  
  236.         FOR i = 1 TO FCOUNT()
  237.             * Check to make sure field is not being used or General/Memo field.
  238.             IF !INLIST(FIELD(m.i),UPPER(THIS.cPivFldRow),;
  239.                 UPPER(THIS.cPivFldCol),UPPER(THIS.cPivFldData)) AND ;
  240.                 !INLIST(tmparr[m.i,2],"G","M")
  241.                 RETURN FIELD(m.i)
  242.             ENDIF
  243.         ENDFOR
  244.         
  245.         RETURN ""
  246.     ENDPROC
  247.     
  248.     FUNCTION stripext
  249.         LPARAMETER filename
  250.         LOCAL dotpos, terminator
  251.         dotpos = RAT(".", m.filename)
  252.         terminator = MAX(RAT("\", m.filename), RAT(":", m.filename))
  253.         IF m.dotpos > m.terminator
  254.            filename = LEFT(m.filename,m.dotpos-1)
  255.         ENDIF
  256.         RETURN m.filename
  257.     ENDFUNC
  258.     
  259. ENDDEFINE